home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 2000 November: Tool Chest / Dev.CD Nov 00 TC Disk 2.toast / pc / sample code / text / namingtableaccess / usfntnamingtable.p < prev   
Encoding:
Text File  |  2000-09-28  |  5.8 KB  |  184 lines
  1. {
  2.     File:        UsfntNamingTable.p
  3.  
  4.     Contains:    a Pascal Unit, and a small application demonstrating its usage. Helps dig
  5.                  out the contents of the NamingTable in a TrueType 'sfnt' (see "The TrueType™
  6.                  Font Format Specification Version 1.0", APDA M0825LL/A, p. 232).
  7.  
  8.                 Access to tables contained in a 'sfnt' has been coded along the lines
  9.                 suggested by Mike Reed (see  d e v e l o p  n° 8, "Curves ahead").
  10.  
  11.     Written by: Joseph Maure    
  12.  
  13.     Copyright:    Copyright © 1991-1999 by Apple Computer, Inc., All Rights Reserved.
  14.  
  15.                 You may incorporate this Apple sample source code into your program(s) without
  16.                 restriction. This Apple sample source code has been provided "AS IS" and the
  17.                 responsibility for its operation is yours. You are not permitted to redistribute
  18.                 this Apple sample source code as "Apple sample source code" after having made
  19.                 changes. If you're going to re-distribute the source, we require that you make
  20.                 it clear in the source that the code was descended from Apple sample source
  21.                 code, but that you've made changes.
  22.  
  23.     Change History (most recent first):
  24.                 8/12/1999    Karl Groethe    Updated for Metrowerks Codewarror Pro 2.1
  25.                 
  26.  
  27. }
  28. unit UsfntNamingTable;
  29. interface
  30. {•  uses •}
  31. {•  Script;  •}
  32.   { for script codes 0 = smRoman, 1 = smJapanese, ..., 31 = smExtArabic, 32 = Uninterp }
  33.   { and language codes 0 = langEnglish, 1 = langFrench, 2 = langGerman, 3 = langItalian, ..., 139 = langSundaneseRom }
  34. {$IFC UNDEFINED THINK_PASCAL}
  35. {$SETC THINK_PASCAL := 0}
  36. {$ENDC}
  37.  
  38. {$IFC NOT THINK_PASCAL}
  39.     uses
  40.         Types, Memory;
  41. {$ENDC}
  42.  
  43.     const
  44. { nameID numbers for content of naming table strings }
  45.         kCopyright = 0;
  46.         kFamily = 1;
  47.         kStyle = 2;
  48.         kUnique = 3;
  49.         kFull = 4;
  50.         kVersion = 5;
  51.         kPostscript = 6;
  52.         kTrademark = 7;
  53.         kManufacturer = 8;
  54.  
  55.  
  56. function NamingTableLookup (sfnt: Handle; var platform, encoding, language, content, index: Integer): Str255;
  57.  
  58. { Returns the name from the naming table which corresponds to the given platform, encoding, language, content ID numbers. }
  59. { A value of -1 for any of these acts as a wildcard; if a name has been found, -1 is replaced by the actual ID. }
  60. { The search should start with index = 0; on return , <index>  points beyond the returned entry, such that the function }
  61. { can be called repeatedly (with wildcard parameters) to find all the names for a given ID specification. }
  62. { If there is no name for a given ID specification in the sfnt, or if an error ocurred,  the empty string is returned.}
  63.  
  64. { platform: 0 = UniChar, no specific encoding;  1 = Macintosh; 2 = ISO }
  65. { encoding: if platform = Macintosh, then encodingID = Macintosh Script Manager code }
  66. {                 if platform = ISO, then encodingID = 0 = 7-bit ASCII, or 1 = ISO 10646, or 2 = ISO 8859-1 }
  67.  
  68.  
  69. implementation
  70.  
  71. { Some of these "hidden" implementation details are inspired by Mike Reed's OutlineAccess code }
  72. { See  d e v e l o p   n° 8 , "Curves ahead " }
  73.  
  74. {$IFC THINK_PASCAL}
  75.     type
  76.         IntegerPtr = ^Integer;
  77. {$ENDC}
  78.  
  79.     function GetNamingTablePtr (sfnt: Handle): IntegerPtr;
  80.         const
  81.             kNumOffset = 4;   { from start of 'sfnt' resource }
  82.             kTableOffset = 12;
  83.         type
  84.             SfntDirectoryEntry = record
  85.                     tableTag: OSType;
  86.                     checkSum: Longint;
  87.                     offset: Longint;
  88.                     iLength: Longint;
  89.                 end;
  90.             SfntTableDirectory = array[0..0] of SfntDirectoryEntry; { actually array[0 .. numOffsets-1] }
  91.             TablePtr = ^SfntTableDirectory;
  92.         var
  93.             p: IntegerPtr;
  94.             dir: TablePtr;
  95.             off: Longint;
  96.             index: Integer;
  97.     begin
  98.         p := IntegerPtr(ord4(sfnt^) + kNumOffset);
  99.         index := p^;  { = number of tables in table directory}
  100.         dir := TablePtr(ord4(sfnt^) + kTableOffset);
  101.         off := 0;
  102.         while index > 0 do
  103.             begin
  104.                 index := index - 1;
  105.                 with dir^[index] do
  106.                     if tableTag = 'name' then
  107.                         begin
  108.                             off := offset;
  109.                             Leave;
  110.                         end;
  111.             end;
  112.         if off > 0 then
  113.             GetNamingTablePtr := IntegerPtr(ord4(sfnt^) + off)
  114.         else
  115.             GetNamingTablePtr := nil;
  116.     end;
  117.  
  118.     function NamingTableLookup (sfnt: Handle; var platform, encoding, language, content, index: Integer): Str255;
  119.         const
  120.             kNumberOfRecs = 2;  { from start of NamingTable }
  121.             kStringStorage = 4;
  122.             kNameRecords = 6;
  123.         type
  124.             SfntNameRecord = record
  125.                     platformID: Integer;
  126.                     encodingID: Integer;
  127.                     languageID: Integer;
  128.                     nameID: Integer;
  129.                     strLength: Integer;
  130.                     strOffset: Integer;
  131.                 end;
  132.             SfntNRArray = array[0..0] of SfntNameRecord; { actually array[0 .. count-1] }
  133.             SfntNRArrayPtr = ^SfntNRArray;
  134.         var
  135.             p0, p: IntegerPtr;
  136.             strStore: Ptr;
  137.             found: Boolean;
  138.             count: Integer;
  139.             s: Str255;
  140.             flags: SignedByte;
  141.     begin
  142.         flags := HGetState(sfnt);
  143.         HLock(sfnt);
  144.         found := false;
  145.         s := '';
  146.         p0 := GetNamingTablePtr(sfnt);
  147.         if p0 <> nil then
  148.             begin
  149.                 p := IntegerPtr(ord4(p0) + kNumberOfRecs);  { points to number of NameRecords in Naming Table in the 'sfnt' }
  150.                 count := p^;
  151.                 p := IntegerPtr(ord4(p0) + kStringStorage);
  152.                 strStore := Ptr(ord4(p0) + p^);  { points to actual string data }
  153.                 p := IntegerPtr(ord4(p0) + kNameRecords);  { now points to nameRecords }
  154.                 while (index < count) and not found do
  155.                     with SfntNRArrayPtr(p)^[index] do
  156.                         begin
  157.                             if (platform = platformID) | (platform = -1) then
  158.                                 if (encoding = encodingID) | (encoding = -1) then
  159.                                     if (language = languageID) | (language = -1) then
  160.                                         found := (content = nameID) | (content = -1);
  161.                             if found then
  162.                                 begin
  163.                                     platform := platformID;
  164.                                     encoding := encodingID;
  165.                                     language := languageID;
  166.                                     content := nameID;
  167.                                 end;
  168.                             index := index + 1;
  169.                         end;
  170.                 if found then
  171.                     with SfntNRArrayPtr(p)^[index - 1] do
  172.                         begin
  173.                             if strLength > 255 then
  174.                                 s[0] := chr(255)
  175.                             else
  176.                                 s[0] := chr(strLength);
  177.                             BlockMove(Ptr(ord4(strStore) + strOffset), @s[1], ord(s[0]));
  178.                         end
  179.             end;
  180.         NamingTableLookup := s;
  181.         HSetState(sfnt, flags);
  182.     end;
  183.  
  184. end.